
#|__________________________________________________________________________
 
workmap3.lsp DO-CLICK
Copyright (c) 1992-2002 by Forrest W. Young


ICON              GENERIC     USES      DOES  ACTION     HAS MENU 
                  FUNCTION  left-click  double-click    right-click 
__________________________________________________________________________ 

data body         SHOW        setcd     open-data       open-data-menu 
data cap          ABOUT       setcd     about-data      about-data-menu
data visuals      SEE         setcd     see-data        see-data-menu 
data summary      REPORT      setcd     report-data     report-data-menu 
data transform    TRANSFORM   setcd     transform-data  transform-data-menu 
data analysis     ANALYZE     setcd     analyze-data    analysis-data-menu 

model body        SHOW        setcm     open-model      open-model-menu 
model cap         ABOUT       setcm     about-model     about-model-menu 
model visuals     SEE         setcm     see-model       see-model-menu 
model summary     REPORT      setcm     report-model    report-model-menu

datasheet body    SHOW        setcds    open-datasheet  open-datasheet-menu 
datasheet cap     ABOUT       setcds    about-datasheet about-datasheet-menu 
datasheet left    RETAIN      setcds    retain-data     retain-datasheet-menu 
  
transformation    SHOW        setct     [re-transform]  [transform-menu] 

analysis          SHOW        setca     [re-analyze]    [analysis-menu] 
____________________________________________________________________________ 

NOTES: 
LEFT-CLICK SELECTED ICON: The options menu's preferences item determines whether a left click on a selected icon is like a left click on an unselected icon (i.e., only selects which object is to be current) or is like a double-click on an icon (i.e., also applies an ACTION to the selected object). 

DRAG . . . . move an icon
CNTL-DRAG. . move icon tree 
______________________________________________ 

FUTURE DIRECTIONS: 
  
ABOUT-MODEL menu item would provide the user a menu with the following items: about-data, about analysis, iterpret-model. This is easy to implement and will be. 

OPEN-TRANSFORMATION and OPEN-ANALYSIS would show a dialog box for the icon's transformation or analysis. The dialog box would show the values from the previous use. If the user changes the values and OK's the dialog, ViSta ask's whether ViSta should re-transform or re-analyze the data.  If so, a new transformation or analysis take places, being iconized by a new transformation-data icon pair, or a new analysis-model icon pair. This is hard to implement, but I think very useful, so I may implement it later, but definitely not now. 

I will be quitting working on this soon, and there are many future direction thoughts I have. The generic functions are very powerful, but are not actually implemented. They would be used as follows: 

Usage:    (generic-function statistical-object &optional menu) 
Examples: 

(SEE OBJECT) 
visualizes a data or model object (could visualize appropriate transformation objects if icon were enhanced) 
  
(SHOW OBJECT) 
shows the databrowswer for a data object; the dataeditor for a dash object; the parameters dialog for a transformation, analysis or model object 

There should be additional generic functions, such as: 
(USE object)    makes the object the current object 
(POPUP object)  pops up the current object's menu. 
(RETAIN object) retains the object's data on the workmap 
(SAVE object)   saves the object's data to the file system 

The system should have speadplot and graphical objects, as well as the data, transformation, datasheet, and model object. They should work with the generic functions. 
|#

(defmeth workmap-proto :do-click (x y m1 m2 &optional ears)
  (send self :the-real-do-click x y m1 m2 ears))

(defmeth workmap-proto :comatose (&optional comatose?)
  (if comatose?
      (defmeth workmap-proto :do-click (&rest args))
      (defmeth workmap-proto :do-click (x y m1 m2 &optional ears)
        (send self :the-real-do-click x y m1 m2 ears)))
  comatose?)

(defmeth workmap-proto :the-real-do-click (x y m1 m2 &optional ears)
  (send *vista* :check-running-system-processes x y m1 m2 self)
     (let* ((n (send self :num-icons))
            (current-time (/ (get-internal-real-time)
                          internal-time-units-per-second))
            (elapsed-time (- current-time (send self :first-click-time)))
            (text-h (+ (send self :text-ascent) 
                    (send self :text-descent)))
            (bar-bottom (+ 20 text-h));32
            (i nil)
            (iconx (send self :x))
            (icony (send self :y))
            (scroll (send self :scroll))
            (scrollx (first scroll))
            (scrolly (second scroll))
            (x+ (- x scrollx))
            (y+ (- y scrolly))
            (toolbar-length (send self :toolbar-length))
            (icon-type)
            (icon-part)
            (data-icon)
            (analysis-icon)
            (model-icon)
            (dash-icon)
            (new-style? (send self :new-icon-style?))
            (old-selected-icon (send self :selected-icon))
            (new-selected-icon nil)
            (new-current-time 0)
            (newxy nil)
            (double-click-time .7)
            (double-click-time-60ths 24)
            (stats-icon-clicked)
            (graph-icon-clicked)
            (object)
            (action)
            (stats-shown?)
            (graph-shown?)
            (model-shown?)
            (trans-shown?)
            (ears? (send self :show-icon-ears?));
            (previous-icon (send self :selected-icon-object))
            (hot-icon);
            (drag t)
            (ix) (iy) (iw) (ih) (ic) (itw) (itx) (ity) (ith)
            ) 
       (send self :freeze-all-icons t)
       (send self :first-click-time current-time)  
       (cond
         ((and *toolbox* (send self :toolbar)
               (< y (+ scrolly 32)) (< x (+ toolbar-length scrollx)))
          (when *verbose* (print (list "toolbar")))
          (send *toolbox* :do-click x+ y+ m1 m2))
         (t
          (cond 
            ((= n 0)
             (when m2 (send *desktop-popup-menu* :popup-menu x+ y+ self)))
            ((> n 0)
             (setf results (send self :do-click-get-hot-icon x y m1 m2 ears icon-part))
             (setf hot-icon (first results))   ;number or nil
             (setf icon-part (second results)) ;string or nil
             (setf new-icon (third results))   ;object
             (setf action (fourth results))    ;string or nil
             (cond
               ((not hot-icon) ;click not on icon (on desktop)
                (when m2 (send *desktop-popup-menu* :popup-menu x+ y+ self)))
               (hot-icon
                (setf icon-type (send new-icon :icon-type)) ;number
                (setf object (send new-icon :object))
                (send  *toolbox* :set-three-buttons)
                (when (or (= icon-type 1) (= icon-type 4) (= icon-type 5))
                                      (setf data-icon t))
                (when (= icon-type 3) (setf model-icon t))
                (when (= icon-type 2) (setf analysis-icon t))
                (when (= icon-type 9) (setf dash-icon t))
                (cond ;SINGLE-CLICK UNSELECTED ICON
                  ((/= hot-icon old-selected-icon) 
                   (send self :first-click-time 
                         (/ (get-internal-real-time) 
                            internal-time-units-per-second))
                   (send new-icon :do-click action)
                   (send self :do-click-on-unselected-icon x y m1 m2
                         new-icon icon-type icon-part hot-icon action)
                   (send self :redraw-titles old-selected-icon new-icon)
                   )

                   ;DOUBLE CLICK SELECTED ICON (FAST SINGLE-CLICK SELECTED ICON)
                  ((and (= hot-icon old-selected-icon) 
                        (<= elapsed-time double-click-time))
                   (send self :do-double-click-on-selected-icon x y m1 m2
                         new-icon icon-type icon-part hot-icon action))


                  ;CLICK SELECTED-ICON (SLOW SINGLE-CLICK SELECTED ICON)
                  ((and (= hot-icon old-selected-icon) 
                        (> elapsed-time double-click-time))
                   (send self :do-click-on-selected-icon x y m1 m2
                         new-icon icon-type icon-part hot-icon action)
                   ));end single/double click cond

               
               (send self :redraw-titles old-selected-icon new-icon)

                (send self :freeze-all-icons nil)
                (send self :redraw-icons)
                (if *seamless-desktop*
                    (send *desktop-container* 
                          :title (strcat "ViSta - The Visual Statistics System       " 
                                         (send @ :proper-name)))
                    (send *workmap* 
                          :title (strcat "WorkMap       " (send @ :proper-name))))
                ));end hot-icon cond

             ));end n condition cond
         ;));end toolbar/workmap cond
       ))
     ))

(defmeth workmap-proto :redraw-titles (old new)
  (let* ((y (send new :y))
         (old-obj (select (send self :icon-list) old)))
    (mapcar #'(lambda (icon)
                (when (not (send icon :deleted?))
                      (send icon :draw-title (send icon :state))))
          (select (send self :icon-list) (send self :redraw-order)))
    ))


(defmeth workmap-proto :do-click-get-hot-icon (x y m1 m2 &optional ears icon-part)
  (let* ((n (send self :num-icons))
         (redraw-order (send self :redraw-order))
         
         (text-h (+ (send self :text-ascent) 
                    (send self :text-descent)))
         (bar-bottom (+ 20 text-h));32
         (icon)
         (icon-type nil)
         (iconx (send self :x))
         (icony (send self :y))
         (new-style? (send self :new-icon-style?))
         (show-ears? (send self :show-icon-ears?))
         (stats-shown?) 
         (graph-shown?)
         (type) (i) (icon) (hot-icon)
         (ix) (iy) (iw) (ih) (ic) (itw) (itx) (ity) (ith) 
         (title-width) (center) (half-width) (text-up-edge) (text-bot-edge)
         )
    (dotimes (j n)
             (setf i  (select redraw-order (- n 1 j)))
             (setf icon (select (send self :icon-list) i))
             (setf icon-type (send icon :icon-type))
             (when (not (send icon :deleted?))
                   (setf ix (select iconx i))
                   (setf iy (select icony i))
                   (setf iw (send icon :width))
                   (setf ih (send icon :height))
                   (setf ic  (+ ix (ceiling (/ iw 2))))
                   (setf itw (send self :text-width (send icon :title)))              
                   (setf itx (- ic (ceiling (/ itw 2))))
                   (setf ity (+ iy ih (send icon :title-separation)))
                   (setf ith (+ text-h 4))  
; icon-type: 1 data 2 analysis 3 model 4 dissim 5 table 6-8 guidetools 9 dash
; (print (list x y m1 m2 j icon-type ix iy iw ih))
                   (cond
                     ((member icon-type '(6 7 8))
                      (return))

                     ((member icon-type '(2 9)) ;dash or transf/analysis icon
                      (when (and (< ix x (+ ix iw)) (< iy y (+ iy ih)))
                            (setf ears "main")
                            (setf hot-icon i)
                            (cond 
                              ((= icon-type 2)
                               (setf icon-part "body"))
                              (t 
                               (if (<= iy y (+ iy 11))
                                   (setf icon-part "cap")
                                   (setf icon-part "body"))))
                            (return)))

                     ((member icon-type '(1 3 4 5)) ;data or model icons
                      (cond
                        ((and (not (= icon-type 3))
                             ;(< (+ ix 25) x (+ ix 42)) (<    iy     y (+ iy 17))
                             ; (< (+ ix 30) x (+ ix 47)) (<    iy     y (+ iy 17))
                              (< (+ ix 26) x (+ ix 43)) (<    iy     y (+ iy 17))
                              (or new-style? 
                                  (send icon :graph-ever-shown?)))
                         (setf icon-part "right-upper")
                         (setf hot-icon i)
                         (setf ears "graph")
                         (return))

                        ((and (not (= icon-type 3))
                             ;(< (- ix 17) x ix)        (< iy y (+ iy 17))
                             ;(< (- ix 22) x (- ix 7))  (< iy y (+ iy 17))
                              (< (- ix 18) x (- ix 3))  (< iy y (+ iy 17))
                              (or new-style? 
                                  (send icon :stats-ever-shown?)))
                         (setf icon-part "left-upper")
                         (setf hot-icon i)
                         (setf ears "stats")
                         (return))

                        ((and ;(< (+ ix 25) x (+ ix 42)) 
                              (< (+ ix 30) x (+ ix 47))
                              (< (+ iy 18) y (+ iy bar-bottom))
                               (or new-style? 
                                   (send icon :graph-ever-shown?)
                                   (send icon :model-ever-shown?)))
                          (setf icon-part "right-lower")
                          (setf hot-icon i)
                          (setf ears (if (= icon-type 3) "graph" "model"))
                          (return))

                        ((and ;(< (- ix 17) x ix)
                               (< (- ix 22) x (- ix 7)) 
                               (< (+ iy 17) y (+ iy bar-bottom))
                               (or new-style? 
                                   (send icon :stats-ever-shown?)
                                   (send icon :transf-ever-shown?)))
                         (setf icon-part "left-lower")
                         (setf hot-icon i)
                         (setf ears (if (= icon-type 3) "stats" "transf"))
                         (return))

                        ((and (< ix x (+ ix iw)) (< iy y (+ iy ih)))
                         (setf ears "main")
                         (setf hot-icon i)
                         (if (<= iy y (+ iy 11))
                             (setf icon-part "cap")
                             (setf icon-part "body"))
                         (return))

                        ((and (< itx x (+ itx itw)) (< ity y (+ ity ith)))
                         (setf hot-icon i)
                         (setf ears "main")
                         (setf icon-part "title")
                         (return))
                        ) ;end cond which part of a data or model icon
                      ) ;end members equal data and model icons
                     ) ;end cond which group of icons (data/model, analysis/dash
                   ) ;end when
             );end loop
             (send self :hot-icon hot-icon)
             (list hot-icon icon-part icon ears)))

(defmeth workmap-proto :do-click-on-unselected-icon 
           (x y m1 m2 new-selected-icon icon-type icon-part hot-icon action)
"Hilights icon and sets current object to the value of the icon's object slot. If button down 1/10 second, does drag icon (drag tree if m1 down)"
    (unless (send self :drag-icon? hot-icon x y m1)
            (setco (send new-selected-icon :object))
            (if m2 (send self :do-right-click 
                         x y m1 m2 new-selected-icon icon-type 
                         icon-part hot-icon action))))

(defmeth workmap-proto :do-click-on-selected-icon 
  (x y m1 m2 new-selected-icon icon-type icon-part hot-icon action)
"If icon body, do nothing, except for dash icon does setcded in case it isn't current. If icon ear, show graph or stats"
  (let* ((data-icon (or (= icon-type 1) (= icon-type 4) (= icon-type 5)))
         (model-icon (= icon-type 3))
         (dash-icon (= icon-type 9))
         (analysis-icon (= icon-type 2))
         (scroll (send self :scroll))
         (scrollx (first scroll))
         (scrolly (second scroll))
         (x+ (- x scrollx))
         (y+ (- y scrolly))
         )
    (unless (send self :drag-icon? hot-icon x y m1)
            (cond
              (data-icon (send (send *workmap* :selected-icon-object) :set-buttons action))
              (model-icon (send (send *workmap* :selected-icon-object) :set-buttons action)))
            (cond
              (m2 (send self :do-right-click 
                        x y m1 m2 new-selected-icon icon-type icon-part hot-icon action))
              ;(dash-icon (setcds (send (send *workmap* :selected-icon-object) :object)))
              
              ((equal action "transf")
               (send *trans-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
              ((equal action "model")
               (send *anal-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
              ((equal action "graph")
               (if data-icon 
                   (visualize-data :dialog nil :menu nil)
                   (visualize-model))
               )
              ((equal action "stats")
               (if data-icon 
                   (summarize-data :dialog nil)
                   (report-model :dialog nil)))))))



#|Replaces method above - only responds to right-click and drag
(defmeth workmap-proto :do-click-on-selected-icon 
  (x y m1 m2 new-selected-icon icon-type icon-part hot-icon action)
  "Wait for second click or process right click or drag."
    (unless (send self :drag-icon? hot-icon x y m1)
            (if m2 (send self :do-right-click x y m1 m2 
                         new-selected-icon icon-type 
                         icon-part hot-icon action))
            ))
|#

(defmeth workmap-proto :do-double-click-on-selected-icon 
  (x y m1 m2 new-selected-icon icon-type icon-part hot-icon action)
  (let* ((data-icon (or (= icon-type 1) (= icon-type 4) (= icon-type 5)))
         (model-icon (= icon-type 3))
         (dash-icon (= icon-type 9))
         (analysis-icon (= icon-type 2))
         (icx (send (send *workmap* :selected-icon-object) :x))
         (icw (send (send *workmap* :selected-icon-object) :width))
         (scroll (send self :scroll))
         (scrollx (first scroll))
         (scrolly (second scroll))
         (x+ (- x scrollx))
         (y+ (- y scrolly))
         )
    (unless (send self :drag-icon? hot-icon x y m1)
            (cond
              ;(m2 (send self :do-right-click x y m1 m2 
              ;          new-selected-icon icon-type icon-part hot-icon action))
              ((equal action "transf")
               (send *trans-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
              ((equal action "model")
               (send *anal-popup-menu*  :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
              ((equal action "graph")
               (if data-icon 
                   (visualize-data :dialog nil :menu nil)
                   (visualize-model)))
              ((equal action "stats")
               (if data-icon 
                   (summarize-data :dialog nil)
                   (report-model :dialog nil)))
              ((equal icon-part "body")
               (cond
                 (data-icon     (edit-data)) ;(edit-data :new t)
                 (dash-icon
                  (if (<= x (+ 10 icx))
                      (create-data-object)
                      (send 
                       (send 
                        (send *workmap* :selected-icon-object) :object) :show-datasheet)))
                 (model-icon    (send current-model :create-data :dialog t))
               ;  (analysis-icon (send 
               ;                  (send 
               ;                   (send *workmap* :selected-icon-object) :analysis)
               ;                  :analysis-summary))
                 ))
              ((equal icon-part "cap")
               (cond 
                 (dash-icon     (about-these-data))
                ; (analysis-icon (about-this-analysis))
                 (data-icon     (about-these-data))
                 (model-icon    (about-the-analysis)))))))
  t)
   


(defmeth workmap-proto :do-right-click 
  (x y m1 m2 new-selected-icon icon-type icon-part hot-icon action)
"Presents appropriate menu or action"
  (let* ((data-icon (or (= icon-type 1) (= icon-type 4) (= icon-type 5)))
         (model-icon (= icon-type 3))
         (dash-icon (= icon-type 9))
         (analysis-icon (= icon-type 2))
         (scroll (send self :scroll))
         (scrollx (first scroll))
         (scrolly (second scroll))
         (icx (send (send *workmap* :selected-icon-object) :x))
         (icw (send (send *workmap* :selected-icon-object) :width))
         (x+ (- x scrollx))
         (y+ (- y scrolly)))
  (cond
    ((equal action "transf")
     (send *trans-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
    ((equal action "stats")
     (send *stats-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
    ((equal action "model")
     (send *anal-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
    ((equal action "graph")
     (send self :freeze-all-icons t)
     (if data-icon 
         (visualize-data :dialog nil :menu t :popup-x (+ x+ 2) :popup-y (+ y+ 2))
         (model-icon (visualize-model)))
     (send self :freeze-all-icons nil))
    ((equal action "stats")
     (if data-icon 
         (send *stats-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*)
         ;(summarize-data :dialog t)
         (report-model :dialog t)))
    ((equal icon-part "cap")
     (cond
       (data-icon  (send *data-icon-cap-menu*   :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
      ; (model-icon (send *model-icon-cap-menu*  :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
       (dash-icon  (send *data-icon-cap-menu*   :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))))
    ((equal icon-part "body")
     (cond
       (data-icon  (send *data-popup-menu*      :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
       (model-icon (send *model-popup-menu*     :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
       (dash-icon  (send *dash-icon-popup-menu* :popup-menu (+ x+ 2) (+ y+ 2) *workmap*))
     ; (analysis-icon (send *current-model* :analysis-summary))
       ))
    (t))))
     